This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Load the required libraries. If you don’t have them installed, please do by running install.packages()

library(plotly)
library(stringr)
library(reshape2)
library(dplyr)
library(readr)

Load the NMR binned csv. Just adapt the path to location of your file. You can use autocompletion using the tab key

Binning_Fusarium_sh1 <- read_csv("../../data/Binning_Fusarium_matz_center_named.csv")

── Column specification ───────────────────────────────────────────────────────────────────────────────────────────────────────
cols(
  .default = col_double()
)
ℹ Use `spec()` for the full column specifications.

Lets have a look at the first rows of this file

head(Binning_Fusarium_sh1)

OK. Be sure to have ppm on the columns and fraction numbers as rows. Now we transform the dataframe as a matrix

DTz <- as.matrix(data.frame(Binning_Fusarium_sh1))

Lets have a look at the structure of the file

str(DTz)
 num [1:135, 1:1603] 1 2 3 4 5 6 7 8 9 10 ...
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr [1:1603] "X." "X.1.00831" "X.0.998305" "X.0.988305" ...

Now we’ll remove the row indexes

DTz <- DTz[,-1] 

And we set the matrix row and colnames according to the ones of the df

colnames(DTz) <- colnames(Binning_Fusarium_sh1)[-1]
rownames(DTz) <- rownames(Binning_Fusarium_sh1)

Let’s transform these data in the long form


mtrx.melt <- melt(DTz, id.vars = c('sample', 'ppm'), measure.vars = 'int')
names(mtrx.melt) <- c('sample', 'ppm', 'int')

Now we can plot a quick 3Dplot to have an overview of the data


p <- plot_ly(z = ~DTz) %>% add_surface()

p

OK so now we want to remove the annoying signals corresponding to the solvents. Here we want to get rid of the signals of DMSO at 2.5 ppm so we can subset the df and remove columns starting with this shift

# we turn the matrix as a df
DTz_df <- as.data.frame(DTz)

# and remove columns starting with the chemical shift we want to avoid, here DMSO signals a 2.5 ppm
DTz_df_sub <- DTz_df %>% 
  select(!starts_with(c('2.4', '2.5', '3.3')))

# we turn this df back as a numerical matrix
DTz_mat_sub <- as.matrix(DTz_df_sub)

Now lets plot again …. Does it looks better ?

p <- plot_ly(z = ~DTz_mat_sub) %>% add_surface()

p

We now turn this as a melted matrix

mtrx.melt_sub <- melt(DTz_mat_sub, id.vars = c('sample', 'ppm'), measure.vars = 'int')
names(mtrx.melt_sub) <- c('sample', 'ppm', 'int')

Now that you have the cleaned data object lets have a look at the 2d map. Be patient, this one is longer to plot.

p <- plot_ly(mtrx.melt_sub, x = ~sample, y = ~ppm, z = ~int, type = "contour",
             colors = 'YlOrRd',
             autocontour = F,
             contours = list(
               start = 10000,
               end = 1200000,
               size = 5000
             )
            )
p

If you want to plot the map with ppm on the x-axis just reverse the axis order. Play with start value (to fix the noise) and size value to fix the contour space. Change color if you wish by changing the color field. For more info on 2d contour plot with plotly check https://plot.ly/r/contour-plots/




p <- plot_ly(mtrx.melt_sub, x = ~ppm, y = ~sample, z = ~int, type = "contour",
             autocontour = F,
             colors = 'YlOrRd',
             contours = list(
               start = 10000,
               end = max(mtrx.melt_sub$int),
               size = 20000
             )
            ) %>% layout(xaxis = list(autorange = "reversed"))

p
htmlwidgets::saveWidget(as_widget(p), "2dNMR.html")
LS0tCnRpdGxlOiAiTk1SIERhdGEgcGxvdHRlciIKb3V0cHV0OgogIGh0bWxfZG9jdW1lbnQ6CiAgICBkZl9wcmludDogcGFnZWQKICBodG1sX25vdGVib29rOiBkZWZhdWx0CiAgcGRmX2RvY3VtZW50OiBkZWZhdWx0Ci0tLQoKVGhpcyBpcyBhbiBbUiBNYXJrZG93bl0oaHR0cDovL3JtYXJrZG93bi5yc3R1ZGlvLmNvbSkgTm90ZWJvb2suIFdoZW4geW91IGV4ZWN1dGUgY29kZSB3aXRoaW4gdGhlIG5vdGVib29rLCB0aGUgcmVzdWx0cyBhcHBlYXIgYmVuZWF0aCB0aGUgY29kZS4gCgoKTG9hZCB0aGUgcmVxdWlyZWQgbGlicmFyaWVzLiBJZiB5b3UgZG9uJ3QgaGF2ZSB0aGVtIGluc3RhbGxlZCwgcGxlYXNlIGRvIGJ5IHJ1bm5pbmcgaW5zdGFsbC5wYWNrYWdlcygpCgpgYGB7cn0KbGlicmFyeShwbG90bHkpCmxpYnJhcnkoc3RyaW5ncikKbGlicmFyeShyZXNoYXBlMikKbGlicmFyeShkcGx5cikKbGlicmFyeShyZWFkcikKCmBgYAoKCkxvYWQgdGhlIE5NUiBiaW5uZWQgY3N2LiBKdXN0IGFkYXB0IHRoZSBwYXRoIHRvIGxvY2F0aW9uIG9mIHlvdXIgZmlsZS4gWW91IGNhbiB1c2UgYXV0b2NvbXBsZXRpb24gdXNpbmcgdGhlIHRhYiBrZXkKCmBgYHtyfQpCaW5uaW5nX0Z1c2FyaXVtX3NoMSA8LSByZWFkX2NzdigiLi4vLi4vZGF0YS9CaW5uaW5nX0Z1c2FyaXVtX21hdHpfY2VudGVyX25hbWVkLmNzdiIpCmBgYAoKTGV0cyBoYXZlIGEgbG9vayBhdCB0aGUgZmlyc3Qgcm93cyBvZiB0aGlzIGZpbGUgCgpgYGB7cn0KaGVhZChCaW5uaW5nX0Z1c2FyaXVtX3NoMSkKYGBgCgpPSy4gQmUgc3VyZSB0byBoYXZlIHBwbSBvbiB0aGUgY29sdW1ucyBhbmQgZnJhY3Rpb24gbnVtYmVycyBhcyByb3dzLgpOb3cgd2UgdHJhbnNmb3JtIHRoZSBkYXRhZnJhbWUgYXMgYSBtYXRyaXgKCmBgYHtyfQpEVHogPC0gYXMubWF0cml4KGRhdGEuZnJhbWUoQmlubmluZ19GdXNhcml1bV9zaDEpKQpgYGAKCkxldHMgaGF2ZSBhIGxvb2sgYXQgdGhlIHN0cnVjdHVyZSBvZiB0aGUgZmlsZSAKCmBgYHtyfQpzdHIoRFR6KQpgYGAKCk5vdyB3ZSdsbCByZW1vdmUgdGhlIHJvdyBpbmRleGVzCgpgYGB7cn0KRFR6IDwtIERUelssLTFdIApgYGAKCkFuZCB3ZSBzZXQgdGhlIG1hdHJpeCByb3cgYW5kIGNvbG5hbWVzIGFjY29yZGluZyB0byB0aGUgb25lcyBvZiB0aGUgZGYKCmBgYHtyfQpjb2xuYW1lcyhEVHopIDwtIGNvbG5hbWVzKEJpbm5pbmdfRnVzYXJpdW1fc2gxKVstMV0Kcm93bmFtZXMoRFR6KSA8LSByb3duYW1lcyhCaW5uaW5nX0Z1c2FyaXVtX3NoMSkKCmBgYApMZXQncyB0cmFuc2Zvcm0gdGhlc2UgZGF0YSBpbiB0aGUgbG9uZyBmb3JtCgpgYGB7cn0KCm10cngubWVsdCA8LSBtZWx0KERUeiwgaWQudmFycyA9IGMoJ3NhbXBsZScsICdwcG0nKSwgbWVhc3VyZS52YXJzID0gJ2ludCcpCm5hbWVzKG10cngubWVsdCkgPC0gYygnc2FtcGxlJywgJ3BwbScsICdpbnQnKQoKCgpgYGAKCk5vdyB3ZSBjYW4gcGxvdCBhIHF1aWNrIDNEcGxvdCB0byBoYXZlIGFuIG92ZXJ2aWV3IG9mIHRoZSBkYXRhCgpgYGB7cn0KCnAgPC0gcGxvdF9seSh6ID0gfkRUeikgJT4lIGFkZF9zdXJmYWNlKCkKCnAKYGBgCgpPSyBzbyBub3cgd2Ugd2FudCB0byByZW1vdmUgdGhlIGFubm95aW5nIHNpZ25hbHMgY29ycmVzcG9uZGluZyB0byB0aGUgc29sdmVudHMuCkhlcmUgd2Ugd2FudCB0byBnZXQgcmlkIG9mIHRoZSBzaWduYWxzIG9mIERNU08gYXQgMi41IHBwbSBzbyB3ZSBjYW4gc3Vic2V0IHRoZSBkZiBhbmQgcmVtb3ZlIGNvbHVtbnMgc3RhcnRpbmcgd2l0aCB0aGlzIHNoaWZ0CgpgYGB7cn0KIyB3ZSB0dXJuIHRoZSBtYXRyaXggYXMgYSBkZgpEVHpfZGYgPC0gYXMuZGF0YS5mcmFtZShEVHopCgojIGFuZCByZW1vdmUgY29sdW1ucyBzdGFydGluZyB3aXRoIHRoZSBjaGVtaWNhbCBzaGlmdCB3ZSB3YW50IHRvIGF2b2lkLCBoZXJlIERNU08gc2lnbmFscyBhIDIuNSBwcG0gYW5kIEgyTyBhdCAzLjMKRFR6X2RmX3N1YiA8LSBEVHpfZGYgJT4lIAogIHNlbGVjdCghc3RhcnRzX3dpdGgoYygnMi40JywgJzIuNScsICczLjMnKSkpCgojIHdlIHR1cm4gdGhpcyBkZiBiYWNrIGFzIGEgbnVtZXJpY2FsIG1hdHJpeApEVHpfbWF0X3N1YiA8LSBhcy5tYXRyaXgoRFR6X2RmX3N1YikKYGBgCgpOb3cgbGV0cyBwbG90IGFnYWluIC4uLi4gRG9lcyBpdCBsb29rcyBiZXR0ZXIgPyAKCmBgYHtyfQpwIDwtIHBsb3RfbHkoeiA9IH5EVHpfbWF0X3N1YikgJT4lIGFkZF9zdXJmYWNlKCkKCnAKYGBgCgpXZSBub3cgdHVybiB0aGlzIGFzIGEgbWVsdGVkIG1hdHJpeAoKYGBge3J9Cm10cngubWVsdF9zdWIgPC0gbWVsdChEVHpfbWF0X3N1YiwgaWQudmFycyA9IGMoJ3NhbXBsZScsICdwcG0nKSwgbWVhc3VyZS52YXJzID0gJ2ludCcpCm5hbWVzKG10cngubWVsdF9zdWIpIDwtIGMoJ3NhbXBsZScsICdwcG0nLCAnaW50JykKYGBgCgpOb3cgdGhhdCB5b3UgaGF2ZSB0aGUgY2xlYW5lZCBkYXRhIG9iamVjdCBsZXRzIGhhdmUgYSBsb29rIGF0IHRoZSAyZCBtYXAuIEJlIHBhdGllbnQsIHRoaXMgb25lIGlzIGxvbmdlciB0byBwbG90LgoKCmBgYHtyfQpwIDwtIHBsb3RfbHkobXRyeC5tZWx0X3N1YiwgeCA9IH5zYW1wbGUsIHkgPSB+cHBtLCB6ID0gfmludCwgdHlwZSA9ICJjb250b3VyIiwKICAgICAgICAgICAgIGNvbG9ycyA9ICdZbE9yUmQnLAogICAgICAgICAgICAgYXV0b2NvbnRvdXIgPSBGLAogICAgICAgICAgICAgY29udG91cnMgPSBsaXN0KAogICAgICAgICAgICAgICBzdGFydCA9IDEwMDAwLAogICAgICAgICAgICAgICBlbmQgPSAxMjAwMDAwLAogICAgICAgICAgICAgICBzaXplID0gNTAwMAogICAgICAgICAgICAgKQogICAgICAgICAgICApCnAKYGBgCgpJZiB5b3Ugd2FudCB0byBwbG90IHRoZSBtYXAgd2l0aCBwcG0gb24gdGhlIHgtYXhpcyBqdXN0IHJldmVyc2UgdGhlIGF4aXMgb3JkZXIuIFBsYXkgd2l0aCBzdGFydCB2YWx1ZSAodG8gZml4IHRoZSBub2lzZSkgYW5kIHNpemUgdmFsdWUgdG8gZml4IHRoZSBjb250b3VyIHNwYWNlLiBDaGFuZ2UgY29sb3IgaWYgeW91IHdpc2ggYnkgY2hhbmdpbmcgdGhlIGNvbG9yIGZpZWxkLiBGb3IgbW9yZSBpbmZvIG9uIDJkIGNvbnRvdXIgcGxvdCB3aXRoIHBsb3RseSBjaGVjayBodHRwczovL3Bsb3QubHkvci9jb250b3VyLXBsb3RzLwoKYGBge3J9CgoKCnAgPC0gcGxvdF9seShtdHJ4Lm1lbHRfc3ViLCB4ID0gfnBwbSwgeSA9IH5zYW1wbGUsIHogPSB+aW50LCB0eXBlID0gImNvbnRvdXIiLAogICAgICAgICAgICAgYXV0b2NvbnRvdXIgPSBGLAogICAgICAgICAgICAgY29sb3JzID0gJ1lsT3JSZCcsCiAgICAgICAgICAgICBjb250b3VycyA9IGxpc3QoCiAgICAgICAgICAgICAgIHN0YXJ0ID0gMTAwMDAsCiAgICAgICAgICAgICAgIGVuZCA9IG1heChtdHJ4Lm1lbHRfc3ViJGludCksCiAgICAgICAgICAgICAgIHNpemUgPSAyMDAwMAogICAgICAgICAgICAgKQogICAgICAgICAgICApICU+JSBsYXlvdXQoeGF4aXMgPSBsaXN0KGF1dG9yYW5nZSA9ICJyZXZlcnNlZCIpKQoKcApodG1sd2lkZ2V0czo6c2F2ZVdpZGdldChhc193aWRnZXQocCksICIyZE5NUi5odG1sIikKYGBgCgo=